Dra. Melanie Kolb
M. en F. C. Gustavo Magallanes-Guijón
Dr. Oliver López-Corona
# Librerías
library(RColorBrewer)
library(funModeling)
library(corrplot)
library(minerva)
Se tiene un marco de datos que contiene varias métricas relacionadas, y se calculó (con la teoría de la información): entropía, información mutua, ganancia de información y relación de ganancia.
Para esto se contó con los datos multivariados (marco de datos de entrada), y todas las variables se evaluaron contra una variable definida (como parámetro “objetivo”).
Acontinuación se presentan cuatro apartados de gráficos del cuerpo de agua Río Metztitlán, sitio sitio.
Los gráficos son en el siguiente orden:
Matriz de Información Mutua
Análisis de correlación basado en la Teoría de la Información
Información mutua
Entropía
Ganancia de información
Proporción de Ganancia (de información)
Todos los cálculos fueron hechos en el entorno y lenguaje de programación R con la biblioteca FunModeling
sitio_mim <- read.csv("data/tlacotepec_mim.csv")
sitio_mim[is.na(sitio_mim)] <- 0
#calculo de MIC
#res_mine=mine(sitio_mim)
library(infotheo)
#sitio_mim <- read.csv("data/tlacotepec_mim.csv")
# Discretizar cada variable
matriz=discretize(sitio_mim)
# Calcular la "correlación" basándonos en información mutua
matriz_im=mutinformation(matriz, method= "emp")
# Truco para visualizar el valor máximo de la escala
# excluyendo la diagonal (variable con respecto a sí misma)
diag(matriz_im)=0
# Gráfico de correlación con color y correlación con información mutua del paquete Infotheo.
corrplot(matriz_im, method="color",type="lower", number.cex=0.6,addCoef.col = "black", tl.col="red", tl.srt=90, tl.cex = 0.9, diag=FALSE, is.corr = F)
eti_sitio = c(
'SAAM',
'OD_mg.L',
'COLI_TOT',
'pH_CAMPO',
'TEMP_AGUA',
'NI_TOT',
'E_COLI',
'HG_TOT',
'CR_TOT',
'AS_TOT',
'TURBIEDAD',
'SST',
'COLOR_VER',
'DUR_TOT',
'N_TOT',
'COLI_FEC',
'N_NH3',
'N_NO2',
'N_NO3')
names_eti_sitio = c(
'Sustancias Activas al Azul de Metileno',
'Oxígeno Disuelto',
'Coliformes Totales',
'Potencial de Hidrógeno',
'Temperatura agua',
'Níquel Total',
'Escherichia coli',
'Mercurio Total',
'Cromo Total',
'Arsénico Total',
'Turbiedad',
'Sólidos Suspendidos Totales',
'Color Verdadero',
'Dureza Total',
'Nitrógeno Total (Cálculo)',
'Coliformes Fecales',
'Nitrógeno Amoniacal',
'Nitrógeno de Nitritos',
'Nitrógeno de Nitratos')
for (i in seq_along(eti_sitio)) {
print(myplot <- ggplot(var_rank_info(sitio_mim, eti_sitio[i]), aes(x = reorder(var, mi),y = mi, fill = var))
+ geom_bar(stat = "identity")
+ coord_flip()
+ theme_bw()
+ xlab("")
+ ylab("Información Mutua")
+ ggtitle(names_eti_sitio[i])
+ theme(plot.title = element_text(hjust = 0.5))
+ guides(fill = FALSE))
#print(var_rank_info(sitio_normal, eti_sitio[i]))
#save table in csv
#name_mi <- names_eti_sitio[i]
#name_table_mi <- paste("csv-graphs/tlaco/mi/",name_mi,"_mi.csv",sep = "")
#write.table(var_rank_info(sitio_mim, eti_sitio[i]), file = name_table_mi, sep = ",", col.names = NA)
#save plot
#plot_mi <- paste("images/tlaco/mi/",name_mi,"_mi.png",sep = "")
#ggsave(plot_mi)
}
for (j in seq_along(eti_sitio)) {
print(myplot <- ggplot(var_rank_info(sitio_mim, eti_sitio[j]), aes(x = reorder(var, en),y = en, fill = var))
+ geom_bar(stat = "identity")
+ coord_flip()
+ theme_bw()
+ xlab("")
+ ylab("Entropía")
+ ggtitle(names_eti_sitio[j])
+ theme(plot.title = element_text(hjust = 0.5))
+ guides(fill = FALSE))
#print(var_rank_info(sitio_normal, eti_sitio[j]))
#save table in csv
#name_en <- names_eti_sitio[j]
#name_table_en <- paste("csv-graphs/tlaco/en/",name_en,"_en.csv",sep = "")
#write.table(var_rank_info(sitio_mim, eti_sitio[j]), file = name_table_en, sep = ",", col.names = NA)
#save plot
#plot_en <- paste("images/tlaco/en/",name_en,"_en.png",sep = "")
#ggsave(plot_en)
}
for (k in seq_along(eti_sitio)) {
print(myplot <- ggplot(var_rank_info(sitio_mim, eti_sitio[k]), aes(x = reorder(var, ig),y = ig, fill = var))
+ geom_bar(stat = "identity")
+ coord_flip()
+ theme_bw()
+ xlab("")
+ ylab("Ganancia de la Información")
+ ggtitle(names_eti_sitio[k])
+ theme(plot.title = element_text(hjust = 0.5))
+ guides(fill = FALSE))
#print(var_rank_info(sitio_normal, eti_sitio[k]))
#save table in csv
#name_ig <- names_eti_sitio[k]
#name_table_ig <- paste("csv-graphs/tlaco/ig/",name_ig,"_ig.csv",sep = "")
#write.table(var_rank_info(sitio_mim, eti_sitio[k]), file = name_table_ig, sep = ",", col.names = NA)
#save plot
#plot_ig <- paste("images/tlaco/ig/",name_ig,"_ig.png",sep = "")
#ggsave(plot_ig)
}
for (l in seq_along(eti_sitio)) {
print(myplot <- ggplot(var_rank_info(sitio_mim, eti_sitio[l]), aes(x = reorder(var, gr),y = gr, fill = var))
+ geom_bar(stat = "identity")
+ coord_flip()
+ theme_bw()
+ xlab("")
+ ylab("Proporción de Ganancia (de información)")
+ ggtitle(names_eti_sitio[l])
+ theme(plot.title = element_text(hjust = 0.5))
+ guides(fill = FALSE))
#print(var_rank_info(sitio_normal, eti_sitio[l]))
#save table in csv
#name_gr <- names_eti_sitio[l]
#name_table_gr <- paste("csv-graphs/tlaco/gr/",name_gr,"_gr.csv",sep = "")
#write.table(var_rank_info(sitio_mim, eti_sitio[l]), file = name_table_gr, sep = ",", col.names = NA)
#save plot
#plot_gr <- paste("images/tlaco/gr/",name_gr,"_gr.png",sep = "")
#ggsave(plot_gr)
}